if (!requireNamespace('pacman', quietly=TRUE)) install.packages('pacman')
pacman::p_load(
            ## data manipulation
            readxl, dplyr, lubridate, tidyr, haven, stringr, DT, skimr, 
            forcats, rsample, zoo, visdat,
            ggplot2, ##::cut_width()/interval()/number()
            ## data analysis
            rsample, recipes, parsnip, glmnet, workflows, dials, tictoc, 
            doParallel, tune, yardstick, broom, purrr,
            ## data visualization
            ggplot2, ggthemes, patchwork, vip, scales
        )
dat_casos <- readxl::read_xls('1_Casos incluidos_codigos_15_06b.xls',
                              sheet='Casos',
                              col_types=c(rep('guess', 7), 'date',
                                          rep('guess', 3), 'date', 
                                          rep('guess', 13),
                                          rep('date',  2),
                                          rep('guess', 4),
                                          rep('date',  2),
                                          rep('guess', 2),
                                          rep('date',  2),
                                          rep('guess', 19), 'date',
                                          rep(c('guess', 'date'), 23),
                                          rep('guess', 3),
                                          rep('numeric', 2), 'guess',
                                          rep(c('guess', 'date'), 23),
                                          rep('guess', 3), 'date',
                                          rep('guess', 162-159)))
dat_casos <- dat_casos|>
    dplyr::mutate(
               idade=(dat_casos$'DATA COLETA' - DN)/lubridate::dyears()
           )
dat_casos$idade[96] <- 15
## 140
## dat_casos|>
##     dplyr::filter(UTI==0 & VM==1)|>
##     dplyr::select(codigo)
dat_casos$UTI[140] <- 1
dat_ct <- readxl::read_xls('1_Casos incluidos_codigos_15_06b.xls',
                           sheet='CT')

## DT::datatable(dat_casos,
##               options=list(pageLength=6),
##               class='cell-border stripe',
##               rownames=FALSE)
## 
## DT::datatable(dat_ct,
##               options=list(pageLength=6),
##               class='cell-border stripe',
##               rownames=FALSE)

Análise descritiva


Idade e medidas binárias

box_idade <- 
    ggplot(dat_casos, aes(x=idade, y=NA))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title=paste('Boxplot das', nrow(dat_casos), 'idades'))+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.text.y=element_blank())

box_sexo <- dat_casos|>
    dplyr::mutate(
               Sexo=dplyr::recode(Sexo,
                                  F=paste(table(Sexo)[1], 'femininos'),
                                  M=paste(table(Sexo)[2], 'masculinos'))
           )|>
    ggplot(aes(x=idade, y=Sexo))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title='por sexo')+
    theme_fivethirtyeight(base_size=14)

box_pcomo <- dat_casos|>
    dplyr::mutate(
               pcomorbidade=dplyr::recode(
                                       pcomorbidade,
                                       '0'=paste(table(pcomorbidade)[1],
                                                 'sem comorbidade'),
                                       '1'=paste(table(pcomorbidade)[2],
                                                 'com comorbidade'))
           )|>
    ggplot(aes(x=idade, y=pcomorbidade))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title='por comorbidade')+
    theme_fivethirtyeight(base_size=14)

box_inter <- dat_casos|>
    dplyr::mutate(
               Internou=dplyr::recode(Internou,
                                      '0'=paste(table(Internou)[1],
                                                'não internaram'),
                                      '1'=paste(table(Internou)[2],
                                                'internaram'))
           )|>
    ggplot(aes(x=idade, y=Internou))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title='por necessidade de internação')+
    theme_fivethirtyeight(base_size=14)

box_uti <- dat_casos|>
    dplyr::mutate(
               UTI=dplyr::recode(
                              UTI,
                              '0'=paste(table(UTI)[1], 'fora de UTI'),
                              '1'=paste(table(UTI)[2], 'em UTI'))
           )|>
    ggplot(aes(x=idade, y=UTI))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title='por necessidade de UTI')+
    theme_fivethirtyeight(base_size=14)

box_vm <- dat_casos|>
    dplyr::mutate(
               VM=dplyr::recode(VM,
                                '0'=paste(table(VM)[1], 'fora de VM'),
                                '1'=paste(table(VM)[2], 'em VM'))
           )|>
    ggplot(aes(x=idade, y=VM))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title='por necessidade de VM')+
    theme_fivethirtyeight(base_size=14)

box_contato <- dat_casos|>
    dplyr::mutate(
               contato=CONTATO_CONFIRMADO_OU_SUSPEITO,
               contato=dplyr::recode(contato,
                                     '0'=paste(table(contato)[1],
                                               'sem contato'),
                                     '1'=paste(table(contato)[2],
                                               'com contato'),
                                     '9'=paste(table(contato)[3],
                                               'não disponível'))
           )|>
    ggplot(aes(x=idade, y=contato))+
    geom_boxplot()+
    geom_jitter(size=4/3, alpha=0.4)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title='por contato confirmado')+
    theme_fivethirtyeight(base_size=13)

(box_idade+box_sexo)/
    (box_pcomo+box_contato)/
    box_inter/
    box_uti/
    box_vm

Idades segredadas pelas medidas

box_wrap1 <- dat_casos|>
    dplyr::mutate(UTI=dplyr::recode(UTI,
                                    '0'='Fora de UTI', '1'='Em UTI'), 
                  pcomorbidade=dplyr::recode(pcomorbidade,
                                             '0'='Sem comorbidade', 
                                             '1'='Com comorbidade'), 
                  Internou=dplyr::recode(Internou,
                                         '0'='& sem internação',
                                         '1'='& com internação'), 
                  VM=dplyr::recode(VM, '0'='Fora de VM', '1'='Em VM')
                  )|>
    ggplot(aes(x=idade, y=UTI))+
    geom_boxplot(outlier.shape=NA)+
    facet_wrap(~pcomorbidade+Internou, scales='free')+
    geom_jitter(aes(color=VM), size=4/2, alpha=0.75)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title=paste('Boxplot das', nrow(dat_casos), 'idades por',
                     'presença de comorbidade,',
                     '\nnecessidade de internação, UTI e VM'))+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d(end=0.5)+
    theme(legend.title=element_blank())

box_wrap2 <- dat_casos|>
    dplyr::mutate(contato=CONTATO_CONFIRMADO_OU_SUSPEITO,
                  contato=dplyr::recode(contato,
                                        '0'='Sem contato',
                                        '1'='Com contato',
                                        '9'='Não disponível'),
                  pcomorbidade=dplyr::recode(pcomorbidade,
                                             '0'='Sem comorbidade', 
                                             '1'='Com comorbidade'),
                  Internou=dplyr::recode(Internou,
                                         '0'='& sem internação',
                                         '1'='& com internação'),
                  UTI=dplyr::recode(UTI, '0'='Fora de UTI', '1'='Em UTI')
                  )|>
    ggplot(aes(x=idade, y=contato))+
    geom_boxplot(outlier.shape=NA)+
    facet_wrap(~pcomorbidade+Internou)+
    geom_jitter(aes(color=UTI), size=4/2, alpha=0.75)+
    stat_summary(fun=mean, geom='point', size=4, color='red')+
    labs(title=paste(
             'presença de comorbidade, necessidade de internação,',
             '\nUTI, e contato confirmado ou suspeito'))+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d(end=0.5)+
    theme(legend.title=element_blank())

box_wrap1/box_wrap2

Comorbidades

dat_comor <-
    dat_casos|>
    dplyr::filter(pcomorbidade==1)|>
    dplyr::select(scomorbidade1:scomorbidade3)|>
    dplyr::mutate(id=haven::as_factor(1:n()),
                  scomorbidade2=dplyr::na_if(scomorbidade2, 0), 
                  scomorbidade3=dplyr::na_if(scomorbidade3, 0))|>
    tidyr::pivot_longer(!id,
                        names_to='sistema', values_to='comorbidade',
                        values_drop_na=TRUE)|>
    dplyr::mutate(comorbidade=stringr::str_to_sentence(comorbidade))
comorSum <-
    dplyr::summarize(dplyr::group_by(dat_comor, comorbidade),
                     av_data=length(id), id='Total')
idSum <-
    dplyr::summarize(dplyr::group_by(dat_comor, id),
                     av_data=length(id), comorbidade='Total')

ggplot(dat_comor, aes(x=comorbidade, y=id))+
    geom_bin2d(fill='#8A8D8F', alpha=0.7)+
    scale_x_discrete(
        limits=c(levels(as.factor(dat_comor$comorbidade)), 'Total')
    )+
    scale_y_discrete(limits=c('Total', rev(unique(dat_comor$id))))+
    geom_point(
        data=idSum, color='#FF8200', alpha=0.6, size=7, shape=15
    )+
    geom_point(
        data=comorSum, color='#FF8200', alpha=0.6, size=7, shape=15
    )+
    geom_text(data=idSum, aes(label=av_data))+
    geom_text(data=comorSum, aes(label=av_data))+
    labs(title='Comorbidades por paciente')+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none',
          axis.text.x=element_text(angle=25, vjust=0.6))

Comorbidades segregadas

col_comor <- comorSum|>
    dplyr::arrange(av_data)|>
    dplyr::mutate(comorbidade=haven::as_factor(comorbidade))|>
    ggplot(aes(y=comorbidade, x=av_data))+
    geom_col(color='#8A8D8F', alpha=0.25)+
    geom_text(aes(label=av_data), position=position_stack(0.5))+
    labs(title=paste0(nrow(idSum), ' pacientes, \n',
                      sum(comorSum$av_data), ' comorbidades')
         )+
    theme_fivethirtyeight(base_size=14)

ids1 <- idSum|>
    dplyr::filter(av_data==1)|>
    dplyr::pull(id)
col_comor1 <- dat_comor|>
    dplyr::filter(id%in%ids1)|>
    dplyr::count(comorbidade)|>
    dplyr::arrange(n)|>
    dplyr::mutate(comorbidade=haven::as_factor(comorbidade))|>
    ggplot(aes(y=comorbidade, x=n))+
    geom_col(color='#8A8D8F', alpha=0.25)+
    geom_text(aes(label=n), position=position_stack(0.5))+
    labs(title=paste0(length(ids1), ' com\n', '1 comorbidade'))+
    theme_fivethirtyeight(base_size=14)

ids23 <- idSum|>
    dplyr::filter(av_data>1)|>
    dplyr::pull(id)
dat_comor23 <- dat_comor|>
    dplyr::filter(id%in%ids23)|>
    dplyr::mutate(id=factor(id))
col_comor23 <- dat_comor23|>
    dplyr::count(comorbidade)|>
    dplyr::arrange(n)|>
    dplyr::mutate(comorbidade=haven::as_factor(comorbidade))|>
    ggplot(aes(y=comorbidade, x=n))+
    geom_col(color='#8A8D8F', alpha=0.25)+
    geom_text(aes(label=n), position=position_stack(0.5))+
    theme_fivethirtyeight(base_size=14)

ids23order <- dat_comor23|>
    dplyr::count(id, sort=TRUE)|>
    dplyr::mutate(id=haven::as_factor(id))|>
    dplyr::pull(id)
bar_comor23 <- dat_comor23|>
    dplyr::mutate(
               id=factor(id, levels=ids23order), Comorbidade=comorbidade
           )|>
    ggplot(aes(x=id, fill=Comorbidade))+
    geom_bar(alpha=0.75)+
    labs(title=paste(length(ids23), 'com +1 comorbidades'))+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.title=element_blank(),
          axis.text.x=element_blank())+
    guides(fill=guide_legend(nrow=3))
layout <- "
AABB
CDDD
"
col_comor+col_comor1+col_comor23+bar_comor23+
    patchwork::plot_layout(design=layout)

Tempo do início dos sintomas

bar_temponum <- dat_casos|>
    dplyr::mutate(tempo=tempo_inicio_sintomas)|>
    dplyr::filter(stringr::str_detect(tempo, '[0-9]'))|>
    dplyr::mutate(tempo=factor(as.numeric(tempo)))|>
    ggplot(aes(y=tempo))+
    geom_bar(color='#8A8D8F', alpha=0.25)+
    geom_text(stat='count',
              aes(label=sprintf('%s (%.1f%%)',
                                after_stat(count),
                                after_stat(100*count/sum(count)))),
              hjust=-0.1)+
    xlim(c(0, 57.5))

bar_tempocha <- dat_casos|>
    dplyr::mutate(tempo=tempo_inicio_sintomas)|>
    dplyr::filter(!stringr::str_detect(tempo, '[0-9]'))|>
    dplyr::mutate(tempo=stringr::str_to_sentence(tempo))|>
    ggplot(aes(y=tempo))+
    geom_bar(color='#8A8D8F', alpha=0.25)+
    geom_text(stat='count',
              aes(label=sprintf('%s (%.1f%%)',
                                after_stat(count),
                                after_stat(100*count/sum(count)))),
              hjust=-0.1)+
    xlim(c(0, 47.5))

(bar_temponum/bar_tempocha)+
    plot_layout(heights=c(3.5, 1))+
    plot_annotation(
        title=paste('Dias a partir do início dos sintomas,',
                    '\npara os', nrow(dat_casos), 'pacientes')
    )&theme_fivethirtyeight(base_size=13)

Tempos segregados

bar_temponumComor <- dat_casos|>
    dplyr::mutate(tempo=tempo_inicio_sintomas)|>
    dplyr::filter(stringr::str_detect(tempo, '[0-9]'))|>
    dplyr::mutate(tempo=factor(as.numeric(tempo)), 
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem', '1'='Com')
                  )|>
    ggplot(aes(y=tempo, fill=Comorbidade))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )

bar_tempochaComor <- dat_casos|>
    dplyr::mutate(tempo=tempo_inicio_sintomas)|>
    dplyr::filter(!stringr::str_detect(tempo, '[0-9]'))|>
    dplyr::mutate(tempo=stringr::str_to_sentence(tempo), 
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem', '1'='Com')
                  )|>
    ggplot(aes(y=tempo, fill=Comorbidade))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )

(bar_temponumComor/bar_tempochaComor)+
    patchwork::plot_layout(heights=c(3.5, 1), guides='collect')+
    patchwork::plot_annotation(
                   title=paste('Dias a partir início dos sintomas,',
                               'por presença de comorbidade', sep='\n')
               )&theme_fivethirtyeight(base_size=13)&
    scale_fill_viridis_d(begin=0.5, end=0.75)

bar_temponumInter <- dat_casos|>
    dplyr::mutate(tempo=tempo_inicio_sintomas)|>
    dplyr::filter(stringr::str_detect(tempo, '[0-9]'))|>
    dplyr::mutate(tempo=factor(as.numeric(tempo)), 
                  Internação=dplyr::recode(Internou,
                                           '0'='Não', '1'='Sim')
                  )|>
    ggplot(aes(y=tempo, fill=Internação))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )

bar_tempochaInter <- dat_casos|>
    dplyr::mutate(tempo=tempo_inicio_sintomas)|>
    dplyr::filter(!stringr::str_detect(tempo, '[0-9]'))|>
    dplyr::mutate(tempo=stringr::str_to_sentence(tempo), 
                  Internação=dplyr::recode(Internou,
                                           '0'='Não', '1'='Sim')
                  )|>
    ggplot(aes(y=tempo, fill=Internação))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )

(bar_temponumInter/bar_tempochaInter)+
    patchwork::plot_layout(heights=c(3.5, 1), guides='collect')+
    patchwork::plot_annotation(
        title=paste('Dias a partir do início dos sintomas,',
                    'por necessidade de internação', sep='\n')
        )&theme_fivethirtyeight(base_size=13)&
    scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)

Raio-X e tomografia

tile_xray <-    
    xtabs(~RAIOX1+RAIOX2, dat_casos)|>
    tibble::as_tibble()|>
    dplyr::mutate(n=factor(n),
                  Primeira=factor(RAIOX1),
                  Primeira=dplyr::recode(Primeira,
                                         '1'='Normal',
                                         '2'='Infiltrado instersticial',
                                         '3'='Condensação opacidade',
                                         '4'='Hiperinsuflação',
                                         '5'='Outro',
                                         '6'='Não realizado'),
                  Segunda=factor(RAIOX2),
                  Segunda=dplyr::recode(Segunda,
                                        '1'='Normal',
                                        '2'='Infiltrado instersticial',
                                        '3'='Condensação opacidade',
                                        '4'='Hiperinsuflação',
                                        '5'='Outro',
                                        '6'='Não realizado')
                  )|>
    ggplot(aes(x=Primeira, y=Segunda, fill=n))+
    geom_tile(color='black', size=0.5, alpha=0.6)+
    geom_text(aes(label=n))+
    labs(title=paste0('Raio-X tórax,\n', nrow(dat_casos), ' pacientes'))+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none',
          axis.title.x=element_text(),
          axis.title.y=element_text(),
          axis.text.x=element_text(angle=30, vjust=0.5))+
    scale_fill_brewer(palette='Spectral', direction=-1)+
    coord_fixed()

tile_tomo <-
    xtabs(~TOMO1+TOMO2, dat_casos)|>
    tibble::as_tibble()|>
    dplyr::mutate(n=factor(n),
                  Primeira=factor(TOMO1),
                  Primeira=dplyr::recode(Primeira,
                                         '1'='Normal',
                                         '2'='Infiltrado instersticial',
                                         '3'='Condensação opacidade',
                                         '4'='Vidro fosco',
                                         '5'='Outro',
                                         '6'='Não realizado'),
                  Segunda=factor(TOMO2),
                  Segunda=dplyr::recode(Segunda,
                                        '1'='Normal',
                                        '2'='Infiltrado instersticial',
                                        '3'='Condensação opacidade',
                                        '4'='Vidro fosco',
                                        '5'='Outro',
                                        '6'='Não realizado')
                  )|>
    ggplot(aes(x=Primeira, y=Segunda, fill=n))+
    geom_tile(color='black', size=0.5, alpha=0.6)+
    geom_text(aes(label=n))+
    labs(title=paste0('Tomografia,\n', nrow(dat_casos), ' pacientes'))+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none',
          axis.title.x=element_text(), 
          axis.title.y=element_text(),
          axis.text.x=element_text(angle=30, vjust=0.5))+
    scale_fill_brewer(palette='Spectral', direction=-1)+
    coord_fixed()

tile_xray|tile_tomo

PCR

line_pcr <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('PCR', 1:8)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='PCR', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=dplyr::if_else(
                                   valor%in%c('INFERIOR 5'), '0', valor
                               ),
                  valor=as.numeric(valor),
                  PCR=factor(PCR)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=PCR, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='PCRs')

line_pcrComor <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('PCR', 1:8)), pcomorbidade)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('PCR'),
                        names_to='PCR', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=dplyr::if_else(
                                   valor%in%c('INFERIOR 5'), '0', valor
                               ),
                  valor=as.numeric(valor),
                  PCR=factor(PCR),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade'))|>
    tidyr::drop_na()|>
    ggplot(aes(x=PCR, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none')+
    scale_color_viridis_d()+
    labs(title='por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_pcr/line_pcrComor

VHS

line_vhs <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('VHS', 1:4)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='VHS', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  VHS=factor(VHS)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=VHS, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='VHSs')

line_vhsComor <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('VHS', 1:4)), pcomorbidade)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('VHS'),
                        names_to='VHS', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  VHS=factor(VHS),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade')
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=VHS, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_vhs/line_vhsComor

Dímero-D

line_dime <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('Dímero-D', 1:8)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='DímeroD', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  DímeroD=factor(DímeroD)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=DímeroD, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='Dímero-Ds')

line_dimeComor <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('Dímero-D', 1:8)), pcomorbidade)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('Dímero-D'),
                        names_to='DímeroD', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  DímeroD=factor(DímeroD),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade')
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=DímeroD, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='Dímero-Ds por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_dime/line_dimeComor

Município

dat_casos|>
    dplyr::mutate(Município=factor(stringr::str_to_title(Município)),
                  Município=factor(Município,
                                   levels=rev(levels(Município))), 
                  Internação=dplyr::recode(Internou,
                                           '0'='Não', '1'='Sim')
                  )|>    
    ggplot(aes(y=Município, fill=Internação))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )+
    theme_fivethirtyeight(base_size=14)+
    scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)+
    labs(title=paste('Município dos', nrow(dat_casos), 'pacientes,',
                     '\npor necessidade de internação'))

Sinais clínicos

sinaisc <- dat_casos|>
    dplyr::select(FEBRE:OUTRO, Internou)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!c(id, Internou, OUTRO),
                        names_to='sinal', values_to='presença')|>
    dplyr::mutate(sinal=stringr::str_to_title(sinal),
                  Internação=dplyr::recode(Internou,
                                           '0'='Não', '1'='Sim'))
sinaiscTable <- sinaisc|>
    dplyr::filter(presença==1)|>
    dplyr::count(sinal)|>
    dplyr::arrange(n)|>
    dplyr::mutate(sinal=haven::as_factor(sinal))

sinallevels <- levels(sinaiscTable$sinal)

ggplot(sinaiscTable, aes(y=sinal, x=n))+
    geom_col(color='#8A8D8F', alpha=0.25)+
    geom_text(aes(label=paste(n, '(', round(100*n/294, 1), '%)')),
              hjust=-0.1)+
    xlim(c(0, 210))+
    labs(
        title=paste('Sinais clínicos dos', nrow(dat_casos), 'pacientes')
    )+
    theme_fivethirtyeight(base_size=13)

Sinais clínicos por internação

sinaisc|>
    dplyr::filter(presença==1)|>
    dplyr::mutate(sinal=factor(sinal, levels=rev(sinallevels)))|>
    ggplot(aes(y=sinal, fill=Internação))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )+
    labs(title=paste('Sinais clínicos dos', nrow(dat_casos),
                     'pacientes,', '\npor necessidade de internação'))+
    theme_fivethirtyeight(base_size=13)+
    scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)

Combinações de sinais clínicos

dat_casos|>
    dplyr::select(FEBRE:AGEUSIA)|>
    dplyr::group_by_all()|>
    dplyr::tally()|>
    dplyr::filter(n>1)|>
    tibble::as_tibble()|>
    dplyr::mutate(profile=as.character(1:dplyr::n()))|>
    tidyr::pivot_longer(
               !c(profile, n), names_to='sinal', values_to='status'
           )|>
    dplyr::filter(status==1)|>
    dplyr::arrange(desc(n))|>
    dplyr::mutate(profile=haven::as_factor(profile),
                  profile=factor(
                      profile, labels=c(1:length(levels(profile)))
                  ),
                  sinal=stringr::str_to_sentence(sinal),
                  sinal=haven::as_factor(sinal)
                  )|>
    ggplot(aes(x=n, y=profile, fill=sinal))+
    geom_col(alpha=0.75)+
    geom_text(aes(label=n), position=position_stack(0.5))+
    theme_fivethirtyeight()+
    theme(legend.title=element_blank())+
    labs(title='Combinações de sinais clínicos com frequência > 1')

dat_casos|>
    dplyr::select(FEBRE:AGEUSIA, Internou)|>
    dplyr::group_by_all()|>
    dplyr::tally()|>
    dplyr::filter(n>1)|>
    tibble::as_tibble()|>
    dplyr::mutate(profile=as.character(1:dplyr::n()))|>
    tidyr::pivot_longer(!c(profile, n, Internou),
                        names_to='sinal', values_to='status')|>
    dplyr::filter(status==1)|>
    dplyr::arrange(desc(n))|>
    dplyr::mutate(profile=haven::as_factor(profile),
                  profile=factor(
                      profile, labels=c(1:length(levels(profile)))
                  ),
                  sinal=stringr::str_to_sentence(sinal),
                  sinal=haven::as_factor(sinal),
                  Internação=dplyr::recode(Internou,
                                           '0'='Sem internação',
                                           '1'='Com internação')
                  )|>
    ggplot(aes(x=n, y=profile, fill=sinal))+
    geom_col(alpha=0.75)+
    facet_wrap(~Internação, scales='free')+
    geom_text(aes(label=n), position=position_stack(0.5))+
    theme_fivethirtyeight()+
    theme(legend.title=element_blank())+
    labs(title=paste(
             'Combinações de sinais clínicos com frequência > 1,',
             '\npor necessidade de internação'))

Outros sinais clínicos

sinaiscoutroTable <- sinaisc|>
    dplyr::mutate(outro=dplyr::na_if(OUTRO, 0),
                  outro=dplyr::recode(outro, '9'='Não disponível'),
                  outro=stringr::str_to_sentence(outro)
                  )|>
    tidyr::drop_na()|>
    dplyr::count(outro)|>
    dplyr::arrange(n)|>
    dplyr::mutate(outro=haven::as_factor(outro))

sinaloutrolevels <- levels(sinaiscoutroTable$outro)

dat_casos|>
    dplyr::mutate(outro=dplyr::na_if(OUTRO, 0),
                  outro=dplyr::recode(outro, '9'='Não disponível'),
                  outro=stringr::str_to_sentence(outro),
                  Internação=dplyr::recode(Internou,
                                           '0'='Não', '1'='Sim')
                  )|>
    dplyr::select(outro, Internação)|>
    tidyr::drop_na()|>
    dplyr::mutate(outro=factor(outro, levels=sinaloutrolevels))|>
    ggplot(aes(y=outro, fill=Internação))+
    geom_bar(alpha=0.75)+
    labs(title=paste('Sinais clínicos dos', nrow(dat_casos),
                     'pacientes,', '\npor necessidade de internação'))+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5)
    )+
    theme_fivethirtyeight(base_size=14)+
    scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)

Linfócitos e neutrófilos

dat_casos|>
    dplyr::select(linfócitos, neutrófilos)|>
    tidyr::gather(key, value)|>
    dplyr::mutate(value=dplyr::recode(value,
                                      '0'='Normal',
                                      '1'='Diminuído',
                                      '2'='Aumentado',
                                      '9'='Não disponível'),
                  key=stringr::str_to_title(key))|>
    ggplot(aes(y=value, fill=key))+
    geom_bar(position='dodge', alpha=0.75)+
    geom_text(stat='count',
              aes(label=sprintf('%s (%.1f%%)',
                                after_stat(count),
                                after_stat(100*count/294))),
              hjust=-0.1, position=position_dodge(1))+
    labs(title='Linfócitos e neutrófilos')+
    xlim(c(0, 220))+
    theme_fivethirtyeight()+
    scale_fill_viridis_d(begin=0.5, end=0.75, direction=-1)+
    theme(legend.title=element_blank())

bar_linfneut <- dat_casos|>
    dplyr::select(linfócitos, neutrófilos)|>
    tidyr::gather(key, value)|>
    dplyr::mutate(value=dplyr::recode(value,
                                      '0'='Normal',
                                      '1'='Diminuído',
                                      '2'='Aumentado',
                                      '9'='Não disponível'),
                  key=stringr::str_to_title(key),
                  key=factor(key, levels=rev(unique(key)))
                  )|>
    ggplot(aes(y=key, fill=value))+
    geom_bar(alpha=0.75)+
    geom_text(
        stat='count', aes(label=..count..), position=position_stack(0.5),
    )+
    theme_fivethirtyeight(base_size=14)+
    scale_fill_viridis_d(begin=0.25, end=0.75)+
    theme(legend.title=element_blank())

line_linf <- dat_casos|>
    dplyr::select(dplyr::one_of(paste0('linfócitos', 1:11)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='linfócitos', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  linfócitos=haven::as_factor(linfócitos)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=linfócitos, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none',
          axis.text.x=element_text(angle=45, vjust=0.6))+
    labs(title='Linfócitos')

line_neut <-
    dat_casos|>
    dplyr::select(dplyr::one_of(paste0('neutrófilos', 1:11)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='neutrófilos', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  neutrófilos=haven::as_factor(neutrófilos)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=neutrófilos, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none',
          axis.text.x=element_text(angle=45, vjust=0.6))+
    labs(title='Neutrófilos')

bar_linfneut/(line_linf|line_neut)+patchwork::plot_layout(heights=c(1, 2))

por comorbidade

line_linfComor <- dat_casos|>
    dplyr::select(
               dplyr::one_of(paste0('linfócitos', 1:11)), pcomorbidade
           )|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('linfócitos'),
                        names_to='linfócitos', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  linfócitos=haven::as_factor(linfócitos),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade')
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=linfócitos, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none',
          axis.text.x=element_text(angle=45, vjust=0.6))+
    labs(title='Linfócitos por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_neutComor <- dat_casos|>
    dplyr::select(
               dplyr::one_of(paste0('neutrófilos', 1:11)), pcomorbidade
           )|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('neutrófilos'),
                        names_to='neutrófilos', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'),
                  valor=as.numeric(valor),
                  neutrófilos=haven::as_factor(neutrófilos),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade')
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=neutrófilos, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none',
          axis.text.x=element_text(angle=45, vjust=0.6))+
    labs(title='Neutrófilos por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_linfComor/line_neutComor

Igs

line_iga <- dat_casos|>
    dplyr::select(iga1, iga2)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='iga', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'), 
                  valor=dplyr::if_else(valor%in%c('Inferior a 10'),
                                       '0',
                                       valor),
                  valor=as.numeric(valor),
                  iga=factor(iga)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=iga, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='IgA')

line_igg <- dat_casos|>
    dplyr::select(igg1, igg2)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='igg', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'), 
                  valor=as.numeric(valor),
                  igg=factor(igg)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=igg, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='IgG')

line_igm <- dat_casos|>
    dplyr::select(igm1, igm2)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='igm', values_to='valor')|>
    dplyr::mutate(valor=dplyr::na_if(valor, 'NR'), 
                  valor=dplyr::if_else(valor%in%c('Inferior a 20'),
                                       '0',
                                       valor),
                  valor=as.numeric(valor),
                  igm=factor(igm)
                  )|>
    tidyr::drop_na()|>
    ggplot(aes(x=igm, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='IgM')

line_iga|line_igg|line_igm

Carga viral

dat_ct <- dat_ct|>
    dplyr::rename('N1/N1'=Resultado...3, 
                  'N2/ORF1ab1'=...4, 
                  'N1/N2'=Resultado...7, 
                  'N2/ORF1ab2'=...8, 
                  'N1/N3'=Resultado...11, 
                  'N2/ORF1ab3'=...12, 
                  'N1/N4'=Resultado...15, 
                  'N2/ORF1ab4'=...16, 
                  'N1/N5'=Resultado...19, 
                  'N2/ORF1ab5'=...20, 
                  'N1/N6'=Resultado...23, 
                  'N2/ORF1ab6'=...24, 
                  'N1/N7'=Resultado...27, 
                  'N2/ORF1ab7'=...28)|>
    dplyr::select(dplyr::starts_with('n'))|>
    dplyr::slice(-1L)|>
    dplyr::mutate(dplyr::across(where(is.character),
                                ~dplyr::na_if(., 'Lab apoio')),
                  dplyr::across(where(is.character),
                                ~dplyr::na_if(., 'NI')),
                  dplyr::across(dplyr::everything(), as.numeric)
                  )
line_n1n <- dat_ct|>
    dplyr::select(dplyr::one_of(paste0('N1/N', 1:7)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='n1n', values_to='valor')|>
    dplyr::mutate(n1n=factor(n1n))|>
    tidyr::drop_na()|>
    ggplot(aes(x=n1n, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='N1/Ns')

line_n1nComor <- dat_ct|>
    dplyr::mutate(pcomorbidade=dat_casos$pcomorbidade)|>
    dplyr::select(dplyr::one_of(paste0('N1/N', 1:7)), pcomorbidade)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('N1/N'),
                        names_to='n1n', values_to='valor')|>
    dplyr::mutate(n1n=factor(n1n),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade'))|>
    tidyr::drop_na()|>
    ggplot(aes(x=n1n, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_n1n/line_n1nComor

line_n2orf1ab <- dat_ct|>
    dplyr::select(dplyr::one_of(paste0('N2/ORF1ab', 1:7)))|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(!id, names_to='n2orf1ab', values_to='valor')|>
    dplyr::mutate(n2orf1ab=factor(n2orf1ab))|>
    tidyr::drop_na()|>
    ggplot(aes(x=n2orf1ab, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='N2/ORF1abs')

line_n2orf1abComor <- dat_ct|>
    dplyr::mutate(pcomorbidade=dat_casos$pcomorbidade)|>
    dplyr::select(dplyr::one_of(paste0('N2/ORF1ab', 1:7)), pcomorbidade)|>
    dplyr::mutate(id=factor(1:dplyr::n()))|>
    tidyr::pivot_longer(dplyr::starts_with('N2/ORF1ab'),
                        names_to='n2orf1ab', values_to='valor')|>
    dplyr::mutate(n2orf1ab=factor(n2orf1ab),
                  Comorbidade=dplyr::recode(pcomorbidade,
                                            '0'='Sem comorbidade',
                                            '1'='Com comorbidade'))|>
    tidyr::drop_na()|>
    ggplot(aes(x=n2orf1ab, y=valor, group=id, color=id, fill=id))+
    geom_line(size=1.25)+
    geom_point(size=2)+
    theme_fivethirtyeight(base_size=14)+
    scale_color_viridis_d()+
    theme(legend.position='none')+
    labs(title='por presença de comorbidade')+
    facet_wrap(~Comorbidade, scales='free')

line_n2orf1ab/line_n2orf1abComor

Séries

dat_serie  <- dat_casos|>
    dplyr::mutate(
               entrada=dat_casos$'DATA COLETA',
               alta=dat_casos$'Data alta',
               inter=dat_casos$'Data internamento',
               entuti=dplyr::na_if(dat_casos$'ENTRADA UTI',
                                   lubridate::ymd_hms(
                                                  '1899-12-31 00:00:00')),
               saiuti=dplyr::na_if(dat_casos$'SAIDA UTI',
                                   lubridate::ymd_hms(
                                                  '1899-12-31 00:00:00')),
               entvm=dplyr::na_if(dat_casos$'INICIO VM',
                                  lubridate::ymd_hms(
                                                 '1899-12-31 00:00:00')),
               saivm=dplyr::na_if(dat_casos$'TERMINO VM',
                                  lubridate::ymd_hms(
                                                 '1899-12-31 00:00:00')),
               obito=Óbito
           )|>
    dplyr::select(
               entrada, inter, entuti, saiuti, entvm, saivm, alta, obito
           )|>
    dplyr::mutate_if(is.POSIXct, as.Date)

casos <- dat_serie|>
    dplyr::arrange(entrada)|>
    dplyr::mutate(data=entrada)|>
    dplyr::count(data)|>
    dplyr::group_by(data)|>
    dplyr::summarize(cases=sum(n))|>
    dplyr::mutate(sumcases=cumsum(cases))

monthsD <- seq(as.Date('2020-04-15'), as.Date('2021-01-15'), by='1 month')

monthsN <- c('Abr', 'Mai', 'Jun', 'Jul', 'Ago',
             'Set', 'Out', 'Nov', 'Dez', 'Jan')

newcases_daily <- casos|>
    ggplot(aes(x=data, y=cases))+
    geom_col(fill='#006cb8')+
    scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
    labs(title='Novos casos diários')+
    annotate('text', x=monthsD[1:9], y=7,
             label=monthsN[1:9], color='#8A8D8F', size=6)+
    theme_fivethirtyeight(base_size=17)

newcases_cum <- casos|>
    ggplot(aes(x=data, y=sumcases))+
    geom_col(fill='#006cb8')+
    scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
    scale_y_continuous(breaks=c(25, 50, 100, 150, 200, 250, 294))+
    labs(title='Novos casos diários acumulados')+
    annotate('text', x=monthsD[1:9], y=272,
             label=monthsN[1:9], color='#8A8D8F', size=6)+
    theme_fivethirtyeight(base_size=17)

newcases_daily/newcases_cum

altas <- dat_serie|>
    dplyr::arrange(alta)|>
    dplyr::mutate(data=alta)|>
    tidyr::drop_na(data)|>
    dplyr::count(data)|>
    dplyr::mutate(n=n*(-1))

obito <- dat_serie|>
    dplyr::filter(obito==1)|>
    dplyr::arrange(alta)|>
    dplyr::mutate(data=alta, active=obito)|>
    dplyr::select(data, active)

inter <- dplyr::bind_rows(dat_serie|>
                          dplyr::arrange(inter)|>
                          dplyr::mutate(data=inter)|>
                          tidyr::drop_na(data)|>
                          dplyr::count(data),
                          altas)|>
    dplyr::arrange(data)|>
    dplyr::group_by(data)|>
    dplyr::summarize(n=sum(n))|>
    dplyr::mutate(active=cumsum(n))|>
    dplyr::rename(Date=data)|>
    tidyr::complete(Date=seq.Date(min(Date), max(Date), by="day"))|>
    tidyr::fill(active)

uti <- dplyr::bind_rows(dat_serie|>
                        dplyr::arrange(entuti)|>
                        dplyr::mutate(data=entuti)|>
                        tidyr::drop_na(data)|>
                        dplyr::count(data),
                        dat_serie|>
                        dplyr::arrange(saiuti)|>
                        dplyr::mutate(data=saiuti)|>
                        tidyr::drop_na(data)|>
                        dplyr::count(data)|>
                        dplyr::mutate(n=n*(-1)))|>
    dplyr::arrange(data)|>
    dplyr::group_by(data)|>
    dplyr::summarize(n=sum(n))|>
    dplyr::mutate(active=cumsum(n))|>
    dplyr::rename(Date=data)|>
    tidyr::complete(Date=seq.Date(min(Date), max(Date), by="day"))|>
    tidyr::fill(active)

vm <- dplyr::bind_rows(dat_serie|>
                       dplyr::arrange(entvm)|>
                       dplyr::mutate(data=entvm)|>
                       tidyr::drop_na(data)|>
                       dplyr::count(data),
                       dat_serie|>
                       dplyr::arrange(saivm)|>
                       dplyr::mutate(data=saivm)|>
                       tidyr::drop_na(data)|>
                       dplyr::count(data)|>
                       dplyr::mutate(n=n*(-1)))|>
    dplyr::arrange(data)|>
    dplyr::group_by(data)|>
    dplyr::summarize(n=sum(n))|>
    dplyr::mutate(active=cumsum(n))|>
    dplyr::rename(Date=data)|>
    tidyr::complete(Date=seq.Date(min(Date), max(Date), by="day"))|>
    tidyr::fill(active)

activecases <- ggplot()+
    geom_area(data=inter, aes(x=Date, y=active, fill='Internação'),
              alpha=0.75)+
    geom_area(data=uti, aes(x=Date, y=active, fill='UTI'))+
    geom_area(data=vm, aes(x=Date, y=active, fill='VM'))+
    geom_bar(data=obito, stat='identity',
             aes(x=data, y=active, fill='Óbito'), width=1.5)+
    scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
    scale_y_continuous(breaks=c(1, 3, 6, 10, 12))+
    labs(title='Casos ativos diários')+
    annotate('text', x=monthsD, y=11, label=monthsN, color='#8A8D8F',
             size=6)+
    theme_fivethirtyeight(base_size=17)+
    scale_fill_manual(values=c('Internação'='#006cb8',
                               'UTI'='#f9db0a',
                               'VM'='#749c64',
                               'Óbito'='#ff0000'))+
    ## scale_fill_manual(values=c('Internação'='8A8D8F',
    ##                            'UTI'='#FF8200',
    ##                            'VM'='#00B2A9',
    ##                            'Óbito'='#0080ff'))+
    theme(legend.title=element_blank())

mm7da <- ggplot()+
    geom_line(data=inter, aes(x=Date, y=zoo::rollmean(active, k=7, fill=0),
                              color='Internação'), size=1.25)+
    geom_line(data=uti, aes(x=Date, y=zoo::rollmean(active, k=7, fill=0),
                            color='UTI'), size=1.25)+
    geom_line(data=vm, aes(x=Date, y=zoo::rollmean(active, k=7, fill=0),
                           color='VM'), size=1.25)+
    geom_line(data=obito, aes(x=data, y=zoo::rollmean(active, k=7, fill=0),
                              color='Óbito'), size=1.25)+
    scale_x_date(date_labels='%m-%Y', date_breaks='1 month')+
    scale_y_continuous(breaks=c(1, 3, 5, 7.5, 10))+
    labs(title='Médias móveis de 7 dias')+
    annotate('text', x=monthsD, y=17.5/2, label=monthsN, color='#8A8D8F',
             size=6)+
    theme_fivethirtyeight(base_size=17)+
    scale_color_manual(values=c('Internação'='#006cb8',
                                'UTI'='#f9db0a',
                                'VM'='#749c64',
                                'Óbito'='#ff0000'))+
    theme(legend.title=element_blank())

activecases/mm7da

Pirâmide etária

tIdade <- dat_casos|>
    dplyr::mutate(Idade=dat_casos$'Idade anos',
                  Idade=cut(idade, breaks=0:18, include.lowest=TRUE),
                  Sexo=dplyr::recode(Sexo,
                                     'F'='Feminino', 'M'='Masculino'))|>
    dplyr::select(Idade, Sexo)
    
tIf <- tIdade|>
    dplyr::filter(Sexo=='Feminino')|>
    ggplot(aes(x=Idade))+
    geom_bar(fill='#f9db0a')+
    geom_text(stat='count', aes(label=..count..), hjust=1.5)+
    scale_y_continuous(limits=c(20, 0), trans='reverse')+
    labs(title='Pirâmide etária',
         subtitle='Feminino')+
    theme_fivethirtyeight(base_size=17)+
    theme(axis.text.x=element_blank(),
          axis.text.y=element_blank(),
          plot.margin=margin(t=1, r=0, b=1, l=1, unit='lines'),
          plot.subtitle=element_text(hjust=1, face='bold'))+
    coord_flip()

tIm <- tIdade|>
    dplyr::filter(Sexo=='Masculino')|>
    ggplot(aes(x=Idade))+
    geom_bar(fill='#006cb8')+
    geom_text(stat='count', aes(label=..count..), hjust=-0.5)+
    scale_y_continuous(limits=c(0, 34))+
    labs(subtitle='Masculino')+
    theme_fivethirtyeight(base_size=17)+
    theme(axis.text.x=element_blank(),
          axis.text.y=element_text(hjust=0.5),
          plot.margin=margin(t=1, r=1, b=1, l=0, unit='lines'),
          plot.subtitle=element_text(face='bold'))+
    coord_flip()

tIf+tIm+patchwork::plot_layout(widths=c(0.9, 1))

Modelos


Dados

Das 162 (+CT) colunas originais, selecionamos (e criamos) as características a serem utilizadas na modelagem.

dat_models <-
    dat_casos|>
    dplyr::mutate(
               Sexo=haven::as_factor(Sexo),
               Idade=cut(
                   idade, breaks=c(0, 1, 2, 4, 10, 18), include.lowest=TRUE
               ),
               Municipio=forcats::fct_collapse(
                                      Município,
                                      Curitiba='CURITIBA',
                                      RM=c('ALMIRANTE TAMANDARE',
                                           'ARAUCARIA',
                                           'CAMPINA GRANDE DO SUL',
                                           'CAMPO LARGO',
                                           'COLOMBO',
                                           'CONTENDA',
                                           'FAZENDA RIO GRANDE',
                                           'PINHAIS',
                                           'PIRAQUARA',
                                           'QUATRO BARRAS',
                                           'QUITANDINHA',
                                           'RIO BRANCO DO SUL',
                                           'SAO JOSE DOS PINHAIS'), 
                                      other_level='Outro'
                                  ),
               nComorbidades=dat_casos$'QUANTAS COMORBIDADES', 
               comoResp=as.numeric(scomorbidade1=='RESPIRATÓRIO'|
                                   scomorbidade2=='RESPIRATÓRIO'|
                                   scomorbidade3=='RESPIRATÓRIO'), 
               comoNeuro=as.numeric(scomorbidade1=='NEUROLÓGICO'|
                                    scomorbidade2=='NEUROLÓGICO'|
                                    scomorbidade3=='NEUROLÓGICO'),
               comoOncoh=as.numeric(scomorbidade1=='ONCO-HEMATO'|
                                    scomorbidade2=='ONCO-HEMATO'|
                                    scomorbidade3=='ONCO-HEMATO'),
               comoCardio=as.numeric(scomorbidade1=='CARDIOVASCULAR'|
                                     scomorbidade2=='CARDIOVASCULAR'|
                                     scomorbidade3=='CARDIOVASCULAR'),
               comoImuno=as.numeric(scomorbidade1=='IMUNOLÓGICO'|
                                    scomorbidade2=='IMUNOLÓGICO'|
                                    scomorbidade3=='IMUNOLÓGICO'),
               comoGene=as.numeric(scomorbidade1=='SD GENÉTICA'|
                                   scomorbidade2=='SD GENÉTICA'|
                                   scomorbidade3=='SD GENÉTICA'),
               comoDiges=as.numeric(scomorbidade1=='DIGESTIVO'|
                                    scomorbidade2=='DIGESTIVO'|
                                    scomorbidade3=='DIGESTIVO'),
               comoEndo=as.numeric(scomorbidade1=='ENDÓCRINO'|
                                   scomorbidade2=='ENDÓCRINO'|
                                   scomorbidade3=='ENDÓCRINO'),
               comoUri=as.numeric(scomorbidade1=='URINÁRIO'|
                                  scomorbidade2=='URINÁRIO'|
                                  scomorbidade3=='URINÁRIO'),
               tSintomas=forcats::fct_collapse(
                                      tempo_inicio_sintomas,
                                      Assintomático='ASSINTOMÁTICO',
                                      '0'=c('0',
                                            'ASSINTOMÁTICO na coleta'), 
                                      'menor7d'=c('1', '2', '3',
                                                  '4', '5', '6'),
                                      'maior7d'=c('7', '8', '9',
                                                  '10', '12', '15')
                                  ), 
               tSintomas=factor(
                   dplyr::recode(tSintomas, 'Não disponivel'='ND')
               ),
               Contato=dplyr::recode(
                                  factor(CONTATO_CONFIRMADO_OU_SUSPEITO),
                                  '0'='Não', '1'='Sim', '9'='ND'), 
               Febre=dplyr::recode(factor(FEBRE),
                                   '0'='Não', '1'='Sim', '9'='ND'), 
               Tosse=dplyr::recode(factor(TOSSE),
                                   '0'='Não', '1'='Sim', '9'='ND'), 
               Coriza=dplyr::recode(factor(CORIZA),
                                    '0'='Não', '1'='Sim', '9'='ND'), 
               Cefaléia=dplyr::recode(factor(CEFALEIA),
                                      '0'='Não', '1'='Sim', '9'='ND'), 
               Diarréia=dplyr::recode(factor(DIARREIA),
                                      '0'='Não', '1'='Sim', '9'='ND'), 
               Odinofagia=dplyr::recode(factor(ODINOFAGIA),
                                        '0'='Não', '1'='Sim', '9'='ND'), 
               Vômito=dplyr::recode(factor(VOMITO),
                                    '0'='Não', '1'='Sim', '9'='ND'), 
               difResp=dplyr::recode(factor(dat_casos$'DIF RESP'),
                                     '0'='Não', '1'='Sim', '9'='ND'), 
               dorAbd=dat_casos$'DOR ABD', 
               Náusea=NAUSEAS, 
               Mialgia=dplyr::recode(factor(MIALGIA),
                                  '0'='Não', '1'='Sim', '9'='ND'), 
               Ageusia=dplyr::recode(factor(AGEUSIA),
                                     '0'='Não', '1'='Sim', '9'='ND'), 
               Cansaço=dplyr::recode(factor(CANSAÇO),
                                     '0'='Não', '1'='Sim', '9'='ND'), 
               Anosmia=dplyr::recode(factor(ANOSMIA),
                                     '0'='Não', '1'='Sim', '9'='ND'), 
               Convulsão=CONVULSÃO, 
               OutroSN=forcats::fct_collapse(OUTRO,
                                             Não='0',
                                             ND='9', 
                                             other_level='Sim'),
               RaioX=forcats::fct_collapse(factor(RAIOX1),
                                           Normal='1',
                                           NR='6', 
                                           other_level='Alterado'),
               Tomografia=forcats::fct_collapse(factor(TOMO1),
                                                Normal='1',
                                                NR='6', 
                                                other_level='Alterado'),
               PCR=dplyr::na_if(PCR1, 'NR'),
               PCR=as.numeric(
                   dplyr::if_else(PCR%in%c('INFERIOR 5'), '0', PCR)
               ),
               PCR=factor(tidyr::replace_na(
                                     as.character(
                                         cut(PCR,
                                             breaks=c(0, 10, 50, 450),
                                             include.lowest=TRUE)
                                     ), 'NR')),
               Linfócitos=forcats::fct_collapse(factor(linfócitos),
                                                Normal='0',
                                                NR='9', 
                                                other_level='Alterado'),
               Neutrófilos=forcats::fct_collapse(factor(neutrófilos),
                                                 Normal='0',
                                                 NR='9', 
                                                 other_level='Alterado'),
               N1N=dat_ct$'N1/N1',
               N1N=factor(
                   tidyr::replace_na(as.character(
                              cut(N1N, breaks=c(10, 20, 30, 45),
                                  include.lowest=TRUE)
                          ), 'ND')),
               N2ORF1ab=dat_ct$'N2/ORF1ab1',
               N2ORF1ab=factor(
                   tidyr::replace_na(as.character(
                              cut(N2ORF1ab, breaks=c(10, 20, 30, 45),
                                  include.lowest=TRUE)
                          ), 'ND')), 
               Internação=factor(
                   dplyr::recode(Internou, '0'='Não', '1'='Sim')
               ), 
               tInternação=dat_casos$'TEMPO INTERNAÇÃO',
               UTI=factor(dplyr::recode(UTI, '0'='Não', '1'='Sim')),
               tUTI=dat_casos$'TEMPO UTI', 
               VM=factor(dplyr::recode(VM, '0'='Não', '1'='Sim')),
               tVM=dat_casos$'TEMPO VM'
           )|>
    dplyr::select(
               Sexo, Idade, Municipio, nComorbidades, comoResp,
               comoNeuro, comoOncoh, comoCardio, comoImuno, comoGene,
               comoDiges, comoEndo, comoUri, tSintomas, Contato, Febre,
               Tosse, Coriza, Cefaléia, Diarréia, Odinofagia, Vômito,
               difResp, dorAbd, Náusea, Mialgia, Ageusia, Cansaço,
               Anosmia, Convulsão, OutroSN, RaioX, Tomografia, PCR,
               Linfócitos, Neutrófilos, N1N, N2ORF1ab, Internação, 
               tInternação, UTI, tUTI, VM, tVM
           )
## dat_models|>
##     visdat::vis_miss()
dat_models|>
    skimr::skim()
Data summary
Name dat_models
Number of rows 294
Number of columns 44
_______________________
Column type frequency:
factor 28
numeric 16
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
Sexo 0 1 FALSE 2 F: 148, M: 146
Idade 0 1 FALSE 5 (4,: 88, (10: 85, [0,: 50, (1,: 37
Municipio 0 1 FALSE 3 Cur: 200, RM: 75, Out: 19
tSintomas 0 1 FALSE 5 men: 177, 0: 45, ND: 39, Ass: 19
Contato 0 1 FALSE 3 Sim: 205, ND: 70, Não: 19
Febre 0 1 FALSE 3 Sim: 182, Não: 104, ND: 8
Tosse 0 1 FALSE 3 Não: 195, Sim: 91, ND: 8
Coriza 0 1 FALSE 3 Não: 222, Sim: 64, ND: 8
Cefaléia 0 1 FALSE 3 Não: 232, Sim: 54, ND: 8
Diarréia 0 1 FALSE 3 Não: 246, Sim: 40, ND: 8
Odinofagia 0 1 FALSE 3 Não: 252, Sim: 34, ND: 8
Vômito 0 1 FALSE 3 Não: 256, Sim: 30, ND: 8
difResp 0 1 FALSE 3 Não: 264, Sim: 22, ND: 8
Mialgia 0 1 FALSE 3 Não: 268, Sim: 18, ND: 8
Ageusia 0 1 FALSE 3 Não: 276, Sim: 10, ND: 8
Cansaço 0 1 FALSE 3 Não: 277, Sim: 9, ND: 8
Anosmia 0 1 FALSE 3 Não: 278, Sim: 8, ND: 8
OutroSN 0 1 FALSE 3 Não: 164, Sim: 122, ND: 8
RaioX 0 1 FALSE 3 NR: 214, Nor: 55, Alt: 25
Tomografia 0 1 FALSE 3 NR: 255, Alt: 30, Nor: 9
PCR 0 1 FALSE 4 NR: 182, [0,: 61, (10: 32, (50: 19
Linfócitos 0 1 FALSE 3 NR: 190, Nor: 67, Alt: 37
Neutrófilos 0 1 FALSE 3 NR: 190, Nor: 57, Alt: 47
N1N 0 1 FALSE 4 (20: 132, [10: 60, ND: 60, (30: 42
N2ORF1ab 0 1 FALSE 4 [10: 107, (20: 93, ND: 58, (30: 36
Internação 0 1 FALSE 2 Não: 223, Sim: 71
UTI 0 1 FALSE 2 Não: 271, Sim: 23
VM 0 1 FALSE 2 Não: 282, Sim: 12

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
nComorbidades 0 1 0.29 0.61 0 0 0 0 3 ▇▂▁▁▁
comoResp 0 1 0.07 0.26 0 0 0 0 1 ▇▁▁▁▁
comoNeuro 0 1 0.07 0.25 0 0 0 0 1 ▇▁▁▁▁
comoOncoh 0 1 0.03 0.17 0 0 0 0 1 ▇▁▁▁▁
comoCardio 0 1 0.03 0.16 0 0 0 0 1 ▇▁▁▁▁
comoImuno 0 1 0.02 0.15 0 0 0 0 1 ▇▁▁▁▁
comoGene 0 1 0.02 0.15 0 0 0 0 1 ▇▁▁▁▁
comoDiges 0 1 0.02 0.14 0 0 0 0 1 ▇▁▁▁▁
comoEndo 0 1 0.02 0.14 0 0 0 0 1 ▇▁▁▁▁
comoUri 0 1 0.00 0.06 0 0 0 0 1 ▇▁▁▁▁
dorAbd 0 1 0.06 0.25 0 0 0 0 1 ▇▁▁▁▁
Náusea 0 1 0.06 0.24 0 0 0 0 1 ▇▁▁▁▁
Convulsão 0 1 0.01 0.12 0 0 0 0 1 ▇▁▁▁▁
tInternação 0 1 3.15 8.00 0 0 0 0 48 ▇▁▁▁▁
tUTI 0 1 0.78 3.89 0 0 0 0 40 ▇▁▁▁▁
tVM 0 1 0.39 2.42 0 0 0 0 24 ▇▁▁▁▁

Dados de treino e teste

Faremos diferentes modelos, olhando para a necessidade de internação, UTI e VM. Com base em cada uma dessas respostas fazemos uma divisão em treino (3/4) e teste (1/4).

dat_inter <- dat_models|>
    dplyr::select(!c(tInternação, UTI, tUTI, VM, tVM))

set.seed(1512)
inter_split <- dat_inter|>
    rsample::initial_split(., strata=Internação, prop=3/4)

inter_train <- inter_split|>rsample::training()
inter_test  <- inter_split|>rsample::testing()

inter_recplr <- recipes::recipe(Internação~., inter_train)|>
    recipes::step_dummy(
                 recipes::all_nominal(), -recipes::all_outcomes()
             )|>
    recipes::step_zv(recipes::all_predictors())|>
    recipes::step_normalize(recipes::all_predictors())

## ---------------------------------------------------------------------
dat_uti <- dat_models|>
    dplyr::select(!c(tUTI, Internação, tInternação, VM, tVM))

set.seed(1513)
uti_split <- dat_uti|>
    rsample::initial_split(., strata=UTI, prop=3/4)

uti_train <- uti_split|>rsample::training()
uti_test  <- uti_split|>rsample::testing()

uti_recplr <- recipes::recipe(UTI~., uti_train)|>
    recipes::step_dummy(
                 recipes::all_nominal(), -recipes::all_outcomes()
             )|>
    recipes::step_zv(recipes::all_predictors())|>
    recipes::step_normalize(recipes::all_predictors())

## ---------------------------------------------------------------------
dat_vm <- dat_models|>
    dplyr::select(!c(tVM, Internação, tInternação, UTI, tUTI))

set.seed(1514)
vm_split <- dat_vm|>
    rsample::initial_split(., strata=VM, prop=3/4)

vm_train <- vm_split|>rsample::training()
vm_test  <- vm_split|>rsample::testing()

vm_recplr <- recipes::recipe(VM~., vm_train)|>
    recipes::step_dummy(
                 recipes::all_nominal(), -recipes::all_outcomes()
             )|>
    recipes::step_zv(recipes::all_predictors())|>
    recipes::step_normalize(recipes::all_predictors())

inter_plr

plr <-
    parsnip::logistic_reg(penalty=tune::tune(), mixture=1)|>
    parsnip::set_engine('glmnet')

lambda_grid <- tibble(penalty=10^seq(-4, -1, length.out=30))

interplr_flow <- workflows::workflow()|>
    workflows::add_model(plr)|>
    workflows::add_recipe(inter_recplr)

set.seed(1516)
inter_folds <- rsample::vfold_cv(inter_train, v=15, strata=Internação)

## doParallel::registerDoParallel()
## tictoc::tic()
interplr_tune <- interplr_flow|>
    tune::tune_grid(resamples=inter_folds,
                    grid=lambda_grid,
                    control=tune::control_grid(save_pred=TRUE),
                    metrics=yardstick::metric_set(roc_auc))
## tictoc::toc()
interplr_tune|>
    tune::select_best()
# A tibble: 1 x 2
  penalty .config              
    <dbl> <chr>                
1  0.0149 Preprocessor1_Model22
(
    interplr_best <- interplr_tune|>
        tune::collect_metrics()|>
        slice(26)
)
# A tibble: 1 x 7
  penalty .metric .estimator  mean     n std_err .config              
    <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
1  0.0386 roc_auc binary     0.985    15 0.00833 Preprocessor1_Model26
interplr_lambdas <- interplr_tune|>
    tune::collect_metrics()|>
    ggplot(aes(x=penalty, y=mean))+ 
    geom_point(size=3)+
    geom_line(lwd=1)+
    geom_label(data=interplr_best, aes(label=round(penalty, 5)))+
    scale_x_log10(labels=scales::label_number())+
    labs(title='Área abaixo da curva ROC',
         subtitle='para diferentes penalidades',
         caption='Penalidade escolhida em destaque')+
    theme_fivethirtyeight(base_size=14)

interplr_lambdaroc <- interplr_tune|>
    tune::collect_predictions(parameters=interplr_best)|>
    yardstick::roc_curve(Internação, .pred_Não)|>
    ggplot(aes(x=(1-specificity), y=sensitivity))+ 
    geom_path(lwd=1)+
    geom_abline(lty=3)+ 
    coord_equal()+
    labs(title='Curva ROC', subtitle='da penalidade escolhida', 
         x='1 - especificidade', y='Sensibilidade')+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")
          ))

interplr_lambdas+
    interplr_lambdaroc+
    patchwork::plot_layout(widths=c(1.5, 1))

interplr_train <- interplr_flow|>
    tune::finalize_workflow(interplr_best)|>
    parsnip::fit(inter_train)

interplr_train|>
    workflows::pull_workflow_fit()|>
    vip::vi()|> ## vip::vip() (it already returns a plot) --------------
    dplyr::group_by(Sign)|>
    dplyr::filter(Importance>1)|>
    dplyr::slice(1:10)|>
    dplyr::mutate(Importance=abs(Importance), ## -----------------------
                  Variable=forcats::fct_reorder(Variable, Importance),
                  Sign=dplyr::recode(Sign,
                                     NEG='Internação: Não',
                                     POS='Internação: Sim'))|>
    ggplot(aes(x=Importance, y=Variable, fill=Sign))+
    facet_wrap(~Sign, scales='free')+
    geom_bar(stat='identity', alpha=0.75)+
    scale_x_continuous(expand=c(0, 0))+
    labs(title='Características mais importantes',
         subtitle='na classificação do desfecho internação')+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none',
          strip.text.x=element_text(size=14, face='bold'))+
    scale_fill_fivethirtyeight()

## broom::tidy(interplr_train)|>
##     dplyr::filter(!estimate==0)|>
##     dplyr::arrange(estimate)|>
##     dplyr::mutate(term=forcats::fct_reorder(term, estimate))|>
##     ggplot(aes(x=estimate, y=term))+
##     geom_vline(xintercept=0, col='red', linetype=2, lwd=0.8)+
##     geom_label(aes(label=round(estimate, 5)))+
##     labs(title='Características com estimativas não nulas')+
##     theme_fivethirtyeight(base_size=14)
interplr_final <- interplr_train|>
    tune::last_fit(inter_split)

interplr_auc <- paste('Área abaixo da curva:',
                      interplr_final|>
                      tune::collect_predictions()|>
                      yardstick::roc_auc(Internação, .pred_Não)|>
                      dplyr::select(.estimate)%>%
                      round(., 5))

interplr_roc <- interplr_final|>
    tune::collect_predictions()|>
    yardstick::roc_curve(Internação, .pred_Não)|>
    ggplot(aes(x=(1-specificity), y=sensitivity))+ 
    geom_path(lwd=1)+
    geom_abline(lty=3)+ 
    coord_equal()+
    labs(title='Curva ROC', subtitle=interplr_auc, 
         x='1 - especificidade', y='Sensibilidade')+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))

interplr_acc <- paste('Acurácia:',
                      interplr_final|>
                      tune::collect_predictions()|>
                      yardstick::accuracy(Internação, .pred_class)|>
                      dplyr::select(.estimate)%>%
                      round(., 3))

interplr_mat <- interplr_final|>
    tune::collect_predictions()|>
    yardstick::conf_mat(Internação, .pred_class)|>
    purrr::pluck(1)|>
    tibble::as_tibble()|>
    dplyr::rename(Predição=Prediction, Realidade=Truth)|>
    ggplot(aes(Predição, Realidade, alpha=n))+
    geom_tile(show.legend=FALSE)+
    geom_text(aes(label=n), colour='white', alpha=1, size=35)+
    labs(title='Necessidade de internação', subtitle=interplr_acc)+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))

interplr_roc | interplr_mat

uti_plr

utiplr_flow <- workflows::workflow()|>
    workflows::add_model(plr)|>
    workflows::add_recipe(uti_recplr)

set.seed(1741)
uti_folds <- rsample::vfold_cv(uti_train, v=15, strata=UTI)

utiplr_tune <- utiplr_flow|>
    tune::tune_grid(resamples=uti_folds,
                    grid=lambda_grid,
                    control=tune::control_grid(save_pred=TRUE),
                    metrics=yardstick::metric_set(roc_auc))
utiplr_tune|>
    tune::select_best()
# A tibble: 1 x 2
  penalty .config              
    <dbl> <chr>                
1  0.0189 Preprocessor1_Model23
(
    utiplr_best <- utiplr_tune|>
        tune::collect_metrics()|>
        slice(25)
)
# A tibble: 1 x 7
  penalty .metric .estimator  mean     n std_err .config              
    <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
1  0.0304 roc_auc binary     0.928     9  0.0209 Preprocessor1_Model25
utiplr_lambdas <- utiplr_tune|>
    tune::collect_metrics()|>
    ggplot(aes(x=penalty, y=mean))+ 
    geom_point(size=3)+
    geom_line(lwd=1)+
    geom_label(data=utiplr_best, aes(label=round(penalty, 5)))+
    scale_x_log10(labels=scales::label_number())+
    labs(title='Área abaixo da curva ROC',
         subtitle='para diferentes penalidades',
         caption='Penalidade escolhida em destaque')+
    theme_fivethirtyeight(base_size=14)

utiplr_lambdaroc <- utiplr_tune|>
    tune::collect_predictions(parameters=utiplr_best)|>
    yardstick::roc_curve(UTI, .pred_Não)|>
    ggplot(aes(x=(1-specificity), y=sensitivity))+ 
    geom_path(lwd=1)+
    geom_abline(lty=3)+ 
    coord_equal()+
    labs(title='Curva ROC', subtitle='da penalidade escolhida', 
         x='1 - especificidade', y='Sensibilidade')+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")
          ))

utiplr_lambdas+
    utiplr_lambdaroc+
    patchwork::plot_layout(widths=c(1.5, 1))

utiplr_train <- utiplr_flow|>
    tune::finalize_workflow(utiplr_best)|>
    parsnip::fit(uti_train)

utiplr_train|>
    workflows::pull_workflow_fit()|>
    vip::vi()|> ## vip::vip() (it already returns a plot) --------------
    dplyr::group_by(Sign)|>
    dplyr::filter(Importance>1)|>
    dplyr::slice(1:10)|>
    dplyr::mutate(Importance=abs(Importance), ## -----------------------
                  Variable=forcats::fct_reorder(Variable, Importance),
                  Sign=dplyr::recode(Sign,
                                     NEG='UTI: Não',
                                     POS='UTI: Sim'))|>
    ggplot(aes(x=Importance, y=Variable, fill=Sign))+
    facet_wrap(~Sign, scales='free')+
    geom_bar(stat='identity', alpha=0.75)+
    scale_x_continuous(expand=c(0, 0))+
    labs(title='Características mais importantes',
         subtitle='na classificação do desfecho UTI')+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none',
          strip.text.x=element_text(size=14, face='bold'))+
    scale_fill_fivethirtyeight()

utiplr_final <- utiplr_train|>
    tune::last_fit(uti_split)

utiplr_auc <- paste('Área abaixo da curva:',
                    utiplr_final|>
                    tune::collect_predictions()|>
                    yardstick::roc_auc(UTI, .pred_Não)|>
                    dplyr::select(.estimate)%>%
                    round(., 5))

utiplr_roc <- utiplr_final|>
    tune::collect_predictions()|>
    yardstick::roc_curve(UTI, .pred_Não)|>
    ggplot(aes(x=(1-specificity), y=sensitivity))+ 
    geom_path(lwd=1)+
    geom_abline(lty=3)+ 
    coord_equal()+
    labs(title='Curva ROC', subtitle=utiplr_auc, 
         x='1 - especificidade', y='Sensibilidade')+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))

utiplr_acc <- paste('Acurácia:',
                    utiplr_final|>
                    tune::collect_predictions()|>
                    yardstick::accuracy(UTI, .pred_class)|>
                    dplyr::select(.estimate)%>%
                    round(., 3))

utiplr_mat <- utiplr_final|>
    tune::collect_predictions()|>
    yardstick::conf_mat(UTI, .pred_class)|>
    purrr::pluck(1)|>
    tibble::as_tibble()|>
    dplyr::rename(Predição=Prediction, Realidade=Truth)|>
    ggplot(aes(Predição, Realidade, alpha=n))+
    geom_tile(show.legend=FALSE)+
    geom_text(aes(label=n), colour='white', alpha=1, size=35)+
    labs(title='Necessidade de UTI', subtitle=utiplr_acc)+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))

utiplr_roc | utiplr_mat

vm_plr

vmplr_flow <- workflows::workflow()|>
    workflows::add_model(plr)|>
    workflows::add_recipe(vm_recplr)

set.seed(1759)
vm_folds <- rsample::vfold_cv(vm_train, v=15, strata=VM)

vmplr_tune <- vmplr_flow|>
    tune::tune_grid(resamples=vm_folds,
                    grid=lambda_grid,
                    control=tune::control_grid(save_pred=TRUE),
                    metrics=yardstick::metric_set(roc_auc))
vmplr_tune|>
    tune::select_best()
# A tibble: 1 x 2
  penalty .config              
    <dbl> <chr>                
1  0.0240 Preprocessor1_Model24
(
    vmplr_best <- vmplr_tune|>
        tune::collect_metrics()|>
        slice(20)
)
# A tibble: 1 x 7
  penalty .metric .estimator  mean     n std_err .config              
    <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <chr>                
1 0.00924 roc_auc binary     0.893     9  0.0374 Preprocessor1_Model20
vmplr_lambdas <- vmplr_tune|>
    tune::collect_metrics()|>
    ggplot(aes(x=penalty, y=mean))+ 
    geom_point(size=3)+
    geom_line(lwd=1)+
    geom_label(data=vmplr_best, aes(label=round(penalty, 5)))+
    scale_x_log10(labels=scales::label_number())+
    labs(title='Área abaixo da curva ROC',
         subtitle='para diferentes penalidades',
         caption='Penalidade escolhida em destaque')+
    theme_fivethirtyeight(base_size=14)

vmplr_lambdaroc <- vmplr_tune|>
    tune::collect_predictions(parameters=vmplr_best)|>
    yardstick::roc_curve(VM, .pred_Não)|>
    ggplot(aes(x=(1-specificity), y=sensitivity))+ 
    geom_path(lwd=1)+
    geom_abline(lty=3)+ 
    coord_equal()+
    labs(title='Curva ROC', subtitle='da penalidade escolhida', 
         x='1 - especificidade', y='Sensibilidade')+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")
          ))

vmplr_lambdas+
    vmplr_lambdaroc+
    patchwork::plot_layout(widths=c(1.5, 1))

vmplr_train <- vmplr_flow|>
    tune::finalize_workflow(vmplr_best)|>
    parsnip::fit(vm_train)

vmplr_train|>
    workflows::pull_workflow_fit()|>
    vip::vi()|> ## vip::vip() (it already returns a plot) --------------
    dplyr::group_by(Sign)|>
    dplyr::filter(Importance>1)|>
    dplyr::slice(1:10)|>
    dplyr::mutate(Importance=abs(Importance), ## -----------------------
                  Variable=forcats::fct_reorder(Variable, Importance),
                  Sign=dplyr::recode(Sign,
                                     NEG='VM: Não',
                                     POS='VM: Sim'))|>
    ggplot(aes(x=Importance, y=Variable, fill=Sign))+
    facet_wrap(~Sign, scales='free')+
    geom_bar(stat='identity', alpha=0.75)+
    scale_x_continuous(expand=c(0, 0))+
    labs(title='Características mais importantes',
         subtitle='na classificação do desfecho VM')+
    theme_fivethirtyeight(base_size=14)+
    theme(legend.position='none',
          strip.text.x=element_text(size=14, face='bold'))+
    scale_fill_fivethirtyeight()

vmplr_final <- vmplr_train|>
    tune::last_fit(vm_split)

vmplr_auc <- paste('Área abaixo da curva:',
                   vmplr_final|>
                   tune::collect_predictions()|>
                   yardstick::roc_auc(VM, .pred_Não)|>
                   dplyr::select(.estimate)%>%
                   round(., 5))

vmplr_roc <- vmplr_final|>
    tune::collect_predictions()|>
    yardstick::roc_curve(VM, .pred_Não)|>
    ggplot(aes(x=(1-specificity), y=sensitivity))+ 
    geom_path(lwd=1)+
    geom_abline(lty=3)+ 
    coord_equal()+
    labs(title='Curva ROC', subtitle=utiplr_auc, 
         x='1 - especificidade', y='Sensibilidade')+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))

vmplr_acc <- paste('Acurácia:',
                   vmplr_final|>
                   tune::collect_predictions()|>
                   yardstick::accuracy(VM, .pred_class)|>
                   dplyr::select(.estimate)%>%
                   round(., 3))

vmplr_mat <- vmplr_final|>
    tune::collect_predictions()|>
    yardstick::conf_mat(VM, .pred_class)|>
    purrr::pluck(1)|>
    tibble::as_tibble()|>
    dplyr::rename(Predição=Prediction, Realidade=Truth)|>
    ggplot(aes(Predição, Realidade, alpha=n))+
    geom_tile(show.legend=FALSE)+
    geom_text(aes(label=n), colour='white', alpha=1, size=35)+
    labs(title='Necessidade de VM', subtitle=vmplr_acc)+
    theme_fivethirtyeight(base_size=14)+
    theme(axis.title.x=element_text(
              margin=unit(c(t=3, r=0, b=0, l=0), "mm")
          ),
          axis.title.y=element_text(
              margin=unit(c(t=0, r=3, b=0, l=0), "mm")))

vmplr_roc | vmplr_mat